home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / Module source / TEFwindMod.txt < prev    next >
Text File  |  1998-05-31  |  9KB  |  346 lines
  1. ¥ 15May93 DBH  Change echovec per mrh.  Separate TEScroller and TEwind code
  2.     ¥ into different files.  Implement lineEnd: method in intepret:
  3. ¥ 14May93 DBH Dropped new: and test: methods.
  4.     ¥ Added enable: and disable: methods 
  5.     ¥ Reworked interpret: to eliminate local variables.
  6.     ¥ Made theTEScroller an ivar.  Lock: and unlock: buffer in interpret:
  7. ¥ 11May93 DBH  NewEventLoop -> quitvec.
  8.     ¥ Handle tabs as 4 spaces.  Make code independent of QEinit file.
  9. ¥ 19May93    mrh    Made theTEscroller a subview.  Added theStack.
  10. ¥ Sept93    mrh    revised for new controls scheme.
  11. ¥ Mar94        mrh adapted for TWstr (buffer for output to TW).  Added INITFONT
  12. ¥                to DS: in StackView.
  13. ¥ Oct 97    mrh updated for PowerMops.
  14.  
  15.  
  16. need    TEScroller
  17. ¥ need    alert
  18.  
  19. TEscroller    theTEscroller
  20.  
  21.  
  22. : TESizeCheck  ( n -- )        ¥ The 2.4 alert was too much of a pest.  Now
  23.     32000 >                    ¥ we just quietly delete some text from the
  24.                             ¥ front.
  25.     IF
  26.         0  2000  setSelect: theTEscroller
  27.         clear: theTEscroller
  28.         32000 dup setSelect: theTEscroller
  29.     THEN  ;
  30.  
  31.  
  32. ¥ support for interpretation
  33.  
  34. ¥ Note: attempting to handle comments by catching '¥' causes problems,
  35. ¥  since '¥' can appear in a number of other situations, including
  36. ¥  named parm specifications and quoted strings.  Best to just not
  37. ¥  handle '¥' - type comments when interpreting from the Mops window.
  38.  
  39. ¥ : skip_line
  40. ¥    13 chsearch: QEstr
  41. ¥    negate more: QEstr
  42. ¥    delete: QEstr  nolim: QEstr ;
  43.  
  44. : skip1
  45.     1 skip: QEstr ;
  46.  
  47.  
  48. : special>bl
  49.     reset: QEstr
  50.     BEGIN
  51.         len: QEstr
  52.     WHILE
  53.         1st: QEstr  0 31 within?  nip
  54.         IF  32 chovwr: QEstr  ELSE  skip1  THEN
  55.     REPEAT
  56.     reset: QEstr ;
  57.  
  58.  
  59.  
  60. ¥ StackView is a view which just displays the top few stack cells.
  61. ¥ A possible problem is that at the time of call, Mops may have a
  62. ¥ variable number of its own quantities on the stack, depending on the
  63. ¥ circumstances of the call.  We avoid this by defining the standard
  64. ¥ DRAW: method to do nothing, and actually do the drawing at regular
  65. ¥ intervals on an idle event, which generally has the same number of
  66. ¥ Mops' quantities on the stack (currently 2).  We do a few tricks to
  67. ¥ avoid unnecessary drawing so the view doesn't flicker too much.  We
  68. ¥ only draw if the depth has changed since the last idle, or if the
  69. ¥ value drawStack? has been set true, which happens when we interpret
  70. ¥ something (and we set it back false ready for next time).
  71.  
  72.     0    value    lastDepth
  73.     0    value    idleCnt
  74. false    value    drawStack?
  75.  
  76.  
  77.  
  78. : EvalFromQE
  79.         ¥ Evaluates contents of QEstr.
  80.  
  81.     special>bl
  82.     true -> drawStack?            ¥ Set stack display to draw on next idle
  83.     lock: QEstr
  84.     get: QEstr  evaluate
  85.     unlock: QEstr
  86.     prompt? fWind? or IF  ok  THEN
  87.     prompt? IF  cr  THEN        ¥ prompt & cr if required
  88. ;
  89.  
  90. : .S+
  91.     -curs
  92.     ." Stack:  "
  93.     depth 0<  IF  ." underflow"    EXIT  THEN
  94.     depth      NIF  ." empty"      EXIT  THEN
  95.     ." depth "  depth .  cr
  96.     sp@ depth 1- FOR  dup .cell cr  4+  NEXT  drop  ;
  97.  
  98.  
  99.  
  100. :class  STACKVIEW  super{ view }
  101.  
  102. :m DS:  { ¥ svPort -- }        ¥ Does the main work for DRAWSTACK:.
  103.  
  104. ¥ First, if it's time to draw the stack, we make sure we've flushed
  105. ¥ any pending output in the main view.
  106.  
  107.     flush_TWstr
  108.  
  109. ¥ Now let's draw that stack...
  110.  
  111.     pushPort -> svPort                    ¥ Port could be anything, so we have to
  112.     get: ^myWind  set: class_as> window    ¥  save and restore
  113.     initFont                            ¥ Ensure font is right
  114.     depth -> lastDepth
  115.     oldVecs
  116.     get: viewRect  swap 15 - swap  put: tempRect
  117.     draw: tempRect                    ¥ Draw a frame
  118.     1 1 inset: tempRect
  119.     addr: tempRect  ClipRect
  120.     clear: tempRect
  121.     10 10 gotoxy  .s+
  122. [ ppc? ] [if]
  123.     
  124. ¥    getbotx: tempRect 2/ negate  0  setOrigin
  125. ¥    10 10 gotoxy  ." FP stack:  "
  126.     f.s+
  127. ¥    0 0 setOrigin
  128. [then]
  129.                                             ¥ include FP stack if on PPC
  130.     newVecs
  131.     noClip                            ¥ Easier than saving and restoring!
  132.     svPort  popPort  ;m
  133.  
  134. :m DRAW:    true -> drawStack?  ;m
  135.  
  136. :m DRAWSTACK:  { x1 -- x1 } ¥ 30Apr94 DBH, one less stack item to manage.
  137.     clrStk? 
  138.     IF            ¥ We've been told to clear the stack, so we do it,
  139.                 ¥  draw it, then get out.
  140.         sp0 sp!
  141. [ ppc? ] [if]
  142.         depth FOR  drop  NEXT        ¥ on PPC, resetting the stack
  143.                                     ¥  pointer won't empty the stack!
  144. [then]
  145.         ds: self
  146.         false -> clrStk?
  147.         x1  EXIT
  148.     THEN
  149.     idleCnt    NIF  5 -> idleCnt  ELSE 1 --> idleCnt  THEN
  150.     depth  lastDepth <>  idleCnt 0= and        ¥ draw if it's time and depth is difft
  151.     drawStack?  or  false -> drawStack?        ¥ but if we're told, we draw anyway
  152.     NIF  x1  EXIT  THEN
  153.     ds: self
  154.     x1 ;m
  155.  
  156. :m IDLE:    drawStack: self  ;m
  157.  
  158. :m CLASSINIT:
  159.     parLeft parTop parRight parTop  setJust: self
  160.     0 0 0 100  setBounds: self  ;m
  161.     
  162. ;class
  163.  
  164.  
  165. stackView    theStack
  166.  
  167. :class    TEFview  super{ view }        ¥ For the TEFwind ContView
  168.  
  169. :m CLASSINIT:
  170.     classinit: super
  171.     parLeft parTop parRight parBottom  setJust: theTEscroller
  172.     0 102 0 0  setBounds: theTEscroller
  173. ;m
  174.  
  175. ;class
  176.  
  177.  
  178. TEFview        TFV            ¥ This will be the ContView
  179.  
  180.  
  181. ¥ ============= Here's the main TEFwind class ===================
  182.  
  183. :class  TEFwind  super{ window+ }
  184.  
  185.     handle    BUFFER        ¥ merely a place to manipulate the TEscrap handle
  186.  
  187. :m CUT:
  188.     cut: theTEscroller
  189.     fixPanRect: theTEscroller
  190.     caretIntoView: theTEscroller  ;m
  191.  
  192. :m COPY:
  193.     copy: theTEscroller  ;m
  194.  
  195. :m PASTE:
  196.     TEScrapHandle  put: buffer  size: buffer
  197.     size: theTEScroller +  TESizeCheck
  198.     paste: theTEscroller
  199.     fixPanRect: theTEscroller
  200.     caretIntoView: theTEscroller  ;m
  201.  
  202. :m CLEAR:
  203.     clear: theTEscroller
  204.     fixPanRect: theTEscroller
  205.     caretIntoView: theTEscroller  ;m
  206.  
  207. :m SelAll:
  208.     0 32767 setSelect: theTEscroller  ;m
  209.  
  210.  
  211. :m INSERT: { addr len -- }
  212.     size: theTEscroller  len +  TESizeCheck
  213.     addr len  insert: theTEscroller  ;m
  214.  
  215.  
  216. :m INTERPRET:  { ¥ echoCR? -- }
  217.     selEnd: theTEscroller  selStart: theTEscroller =
  218.     IF                                    ¥ nothing selected
  219.         getLine: theTEscroller  ( addr len )  put: QEstr
  220.         true -> echoCR?
  221.     ELSE                                ¥ we have a hilited selection
  222.         handle: theTEscroller  TECopy
  223.         TEScrapHandle  put: buffer
  224.         lock: buffer
  225.         ptr: buffer  size: buffer  ( addr len )  put: QEstr
  226.         unlock: buffer
  227.         false -> echoCR?
  228.     THEN
  229.     lineEnd: theTEscroller dup setselect: theTEscroller
  230.     echoCR? IF  cr  THEN
  231.     evalFromQE  flush_TWstr
  232. ;m
  233.  
  234.  
  235. :m KEY:        ¥ ( char -- )
  236.     doing_key?  IF  drop  EXIT  THEN        ¥ KEY is handling it - we
  237.                                             ¥  mustn't do anything here
  238.     CASE[ 3 ( enter )    ]=>    interpret: self
  239.         [ 8 ( delete )    ]=> 8 key: theTEscroller    ¥ delete
  240.         [ 9 ( tab )        ]=>    4 spaces
  241.  
  242.         DEFAULT=>    size: theTEscroller 1+ TESizeCheck
  243.                      key: theTEscroller
  244.     ]CASE
  245. ;m
  246.  
  247. :m ENABLE:    enable: super    newVecs  ;m    
  248. :m DISABLE:    disable: super  ;m
  249.  
  250.  
  251. :m DRAW:
  252.     ds: theStack
  253.     (draw): super
  254. ;m
  255.  
  256.  
  257. ¥ :m IDLE:    idle: super  ;m
  258.  
  259. :m TextHandle:    textHandle: theTEscroller  ;m
  260.  
  261.  
  262. :m DUMP:
  263.     dump: theTEscroller ;m
  264.  
  265. ;class
  266.  
  267.                 
  268. handle    tmpHndl
  269. file    WorksheetFile
  270.  
  271. 0    value    ^TW
  272.  
  273. : SAVEWORKSHEET
  274.     " Worksheet"  name: worksheetFile
  275.     'type TEXT  'type MSET  set: worksheetfile
  276.     create: worksheetFile  ?EXIT            ¥ If we're on a network, this
  277.                                             ¥ may fail, so we just get out.
  278.     textHandle: [ ^TW ]  put: tmpHndl  lock: tmpHndl
  279.     ptr: tmpHndl  size: tmpHndl  write: worksheetFile  drop
  280.     release: tmpHndl
  281.     close: worksheetFile  drop  ;
  282.  
  283.  
  284. : GETWORKSHEET    { ¥ adr n -- }
  285.     " Worksheet"  name: worksheetFile
  286.     open: worksheetFile
  287.     IF  .room  EXIT  THEN            ¥ If it doesn't exist, we'll start a
  288.                                     ¥ new one with a .room display, and out.
  289.     size: worksheetFile  -> n
  290.     n  new: tmpHndl  lock: tmpHndl
  291.     ptr: tmpHndl  -> adr
  292.     adr n  read: worksheetFile
  293.     dup -39 =  if  drop  0  then  OK?        ¥ We don't worry if the error
  294.                                             ¥  was endfile
  295.     bytesRead: worksheetFile  -> n
  296.     close: worksheetFile  drop
  297.     adr n insert: [ ^TW ]
  298.     release: tmpHndl  ;
  299.  
  300.  
  301. : DO_RUN_TE  { TW-addr ¥ ^view left top rt bot sRt sBot -- }
  302.     -curs  -echo
  303.     TW-addr -> ^TW
  304.     deep_classinit: [ ^TW ]
  305. ¥    fWind? IF  close: fWind  THEN        ¥ say goodbye to Mr. fwind
  306.  
  307.     theStack addView: TFV  theTEscroller addView: TFV
  308. ¥    pause pause pause                    ¥ Get us to the front under sys 6
  309.                                         ¥  or the system clobbers scroll bars
  310.     20 -> left  50 -> top
  311.     520 -> rt  360 -> bot
  312.     screenbits  -> sBot  -> sRt  2drop
  313.     rt sRt min  -> rt
  314.     bot sBot min  -> bot
  315.     left top rt bot  put: tempRect
  316.     screenbits true setGrow: [ ^TW ]
  317.     screenbits true setDrag: [ ^TW ]
  318.     true  setZoom: [ ^TW ]
  319.  
  320.     true  setColor: [ ^TW ]        ¥ is this OK?
  321.  
  322.     tempRect  myDoc  docWind  true false  TFV  new: [ ^TW ]
  323.     true focus: theTEScroller
  324.     newvecs
  325.     true -> emit?                ¥ EMIT is now safe since we have a window
  326. ¥    true -> relocChk?
  327.     xts{  xUndo null xCut xCopy xPaste xClear xSelAll null doPref }
  328.                                                         3  init: EditMen
  329.     getworksheet
  330.     false -> fWindActive?        ¥ Mustn't forget this!!
  331. ¥    eventLoop
  332.     QUIT
  333. ;
  334.  
  335. : BYE+        saveWorksheet  bye  ;
  336.  
  337. : xCut        cut:  [ ^TW ]  ;
  338. : xCopy        copy: [ ^TW ]  ;
  339. : xPaste    paste: [ ^TW ]  ;
  340. : xClear    clear: [ ^TW ]  ;
  341. : xUndo        nimpl  ;
  342. : xSelAll    selAll: [ ^TW ]  ;
  343.  
  344.  
  345. endload
  346.